Data

This section illustrates how to access data, and defines helper methods to filter, map, summarise, and plot data.

Once refined, these helper functions will become core wastdr functionality.

Caveat

  • The data as shown is still pre-QA until this message disappears.
  • Usernames are still hilariously wrong after matching the usernames (as submitted) to the actual usernames in WAStD. See the field commments for QA messages.

Load data

if (file.exists("~/tracks.Rda")){
    load("~/tracks.Rda")
} else {
    track_records <- wastdr::get_wastd("turtle-nest-encounters")
    save_file <- Sys.getenv("WASTDR_SAVE_LOCALLY", unset = FALSE)
    if (save_file==TRUE){
        save(track_records, file = "~/track_records.Rda")
        load("~/track_records.Rda")
    }
    # listviewer::jsonedit(utils::head(track_records$features))
    tracks <- parse_turtle_nest_encounters(track_records)
    if (save_file == TRUE){
        save(tracks, file = "~/tracks.Rda")
    }
}

Filter data

To filter records to one area, we can either filter by area or site ID (once enabled), or simply filter by a bounding box. Additionaly, we’ll filter by date.

In this example, we’ll filter to an area surveyed by the West Pilbara Turtle Program.

species_colours <- tibble::tibble(
    species = c(
    "cheloniidae-fam",
    "chelonia-mydas",
    "eretmochelys-imbricata",
    "natator-depressus",
    "corolla-corolla",
    "lepidochelys-olivacea",
    "caretta-caretta"    
    ),
    species_colours = c(
    "gray",
    "green",
    "darkblue",
    "beige",
    "pink",
    "darkgreen",
    "orange"
    )
)

nest_type_text <- tibble::tibble(
    nest_type = c(
        "hatched-nest", 
        "successful-crawl",
        "track-not-assessed",
        "track-unsure",
        "nest",
        "false-crawl"),
    nest_type_text = c(
        "NH", 
        "N",
        "T+?",
        "N?",
        "N",
        "T")
)


add_lookups <- . %>% 
    left_join(species_colours, by="species") %>%
    left_join(nest_type_text, by="nest_type")

filter_2017 <- . %>% dplyr::filter(date > dmy("17/11/2017")) %>% add_lookups
filter_broome <- . %>% dplyr::filter(area_name=="Cable Beach Broome")
filter_eighty_mile_beach <- . %>% dplyr::filter(area_name=="Eighty Mile Beach Caravan Park")
filter_anna_plains <- . %>% dplyr::filter(area_name=="Anna Plains")
filter_port_hedland <- . %>% dplyr::filter(site_name=="Port Hedland Turtle Nesting Beaches")
filter_west_pilbara <- . %>% dplyr::filter(area_name=="West Pilbara Turtle Program beaches Wickam")
filter_delambre <- . %>% dplyr::filter(area_name=="Delambre Island")
filter_rosemary <- . %>% dplyr::filter(area_name=="Rosemary Island")
filter_thevenard <- . %>% dplyr::filter(area_name=="Thevenard Island")

Map data

tracks_map <- function(track_data) {
    l <- leaflet(width=800, height=600) %>% 
        addProviderTiles("Esri.WorldImagery", group = "Aerial") %>%
        addProviderTiles("OpenStreetMap.Mapnik", group = "Place names") %>%
        clearBounds()

    tracks.df <-  track_data %>% split(track_data$species)
    
    names(tracks.df) %>%
        purrr::walk( function(df) {
            l <<- l %>%
                addAwesomeMarkers(
                    data = tracks.df[[df]],
                    lng = ~longitude, lat=~latitude,
                    icon = leaflet::makeAwesomeIcon(
                        text = ~nest_type_text,
                        markerColor = ~species_colours),
                    label=~paste(date, nest_age, species, nest_type, name),
                    popup=~paste(date, nest_age, species, nest_type, name),
                    group = df
                )
        })
    
    l %>%
        addLayersControl(
            baseGroups = c("Aerial", "Place names"),
            overlayGroups = names(tracks.df),
            options = layersControlOptions(collapsed = FALSE)
        )
}

Summarise and plot data

Data (all tracks or filtered subsets) are filtered to only fresh observations, then grouped and tallied by date, species and type.

Daily summaries are shown in wide form as tables, and (using long form) as timeseries plots.

daily_species_by_type <- . %>% 
    filter(nest_age=="fresh") %>%
    group_by(date, species, nest_type) %>% 
    tally() %>%
    ungroup()

daily_summary <- . %>% 
    daily_species_by_type %>% 
    tidyr::spread(nest_type, n, fill=0) %>%
    DT::datatable(.)

tracks_ts <- . %>% 
    daily_species_by_type %>% 
    {ggplot2::ggplot(data=., aes(x = date, y = n, colour = nest_type)) + 
            ggplot2::geom_point() + 
            ggplot2::geom_smooth(method = "auto") +
            # ggplot2::geom_line() +
            ggplot2::scale_x_date(breaks = scales::pretty_breaks(),
                                  labels = scales::date_format("%d %b %Y")) +
            ggplot2::xlab("Date") +
            ggplot2::ylab("Number counted per day") +
            ggplot2::ggtitle("Nesting activity") +
            ggplot2::theme_light()}

Nesting activity

This chapter uses the data and helpers from the above section and provides some insight into the different regions.

This section is by no means complete and can be extended as appropriate.

Overall

tracks %>% filter_2017 %>% tracks_map

Broome Cable Beach

tracks_cbb <- tracks %>% filter_2017 %>% filter_broome
tracks_cbb %>% tracks_map
tracks_cbb %>% DT::datatable(.)
tracks_cbb %>% daily_summary
tracks_cbb %>% tracks_ts
#> `geom_smooth()` using method = 'loess'
#> Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
#> parametric, : span too small. fewer data values than degrees of freedom.
#> Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
#> parametric, : pseudoinverse used at 17496
#> Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
#> parametric, : neighborhood radius 20.21
#> Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
#> parametric, : reciprocal condition number 0
#> Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
#> parametric, : There are other near singularities as well. 493.28
#> Warning in predLoess(object$y, object$x, newx = if
#> (is.null(newdata)) object$x else if (is.data.frame(newdata))
#> as.matrix(model.frame(delete.response(terms(object)), : span too small.
#> fewer data values than degrees of freedom.
#> Warning in predLoess(object$y, object$x, newx = if
#> (is.null(newdata)) object$x else if (is.data.frame(newdata))
#> as.matrix(model.frame(delete.response(terms(object)), : pseudoinverse used
#> at 17496
#> Warning in predLoess(object$y, object$x, newx = if
#> (is.null(newdata)) object$x else if (is.data.frame(newdata))
#> as.matrix(model.frame(delete.response(terms(object)), : neighborhood radius
#> 20.21
#> Warning in predLoess(object$y, object$x, newx = if
#> (is.null(newdata)) object$x else if (is.data.frame(newdata))
#> as.matrix(model.frame(delete.response(terms(object)), : reciprocal
#> condition number 0
#> Warning in predLoess(object$y, object$x, newx = if
#> (is.null(newdata)) object$x else if (is.data.frame(newdata))
#> as.matrix(model.frame(delete.response(terms(object)), : There are other
#> near singularities as well. 493.28


named_nests_cbb <- tracks_cbb %>% filter(!(is.na(name)))
named_nests_cbb %>% tracks_map
named_nests_cbb %>% DT::datatable(.)

Anna Plains

tracks_ap <- tracks %>% filter_2017 %>% filter_anna_plains
tracks_ap %>% tracks_map
tracks_ap %>% DT::datatable(.)
tracks_ap %>% daily_summary
tracks_ap %>% tracks_ts
#> `geom_smooth()` using method = 'loess'

Eighty Mile Beach

tracks_emb <- tracks %>% filter_2017 %>% filter_eighty_mile_beach
tracks_emb %>% tracks_map
tracks_emb %>% DT::datatable(.)
tracks_emb %>% daily_summary
tracks_emb %>% tracks_ts
#> `geom_smooth()` using method = 'loess'
#> Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
#> parametric, : pseudoinverse used at 17496
#> Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
#> parametric, : neighborhood radius 7.05
#> Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
#> parametric, : reciprocal condition number 2.3619e-17
#> Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
#> parametric, : There are other near singularities as well. 49.702
#> Warning in predLoess(object$y, object$x, newx = if
#> (is.null(newdata)) object$x else if (is.data.frame(newdata))
#> as.matrix(model.frame(delete.response(terms(object)), : pseudoinverse used
#> at 17496
#> Warning in predLoess(object$y, object$x, newx = if
#> (is.null(newdata)) object$x else if (is.data.frame(newdata))
#> as.matrix(model.frame(delete.response(terms(object)), : neighborhood radius
#> 7.05
#> Warning in predLoess(object$y, object$x, newx = if
#> (is.null(newdata)) object$x else if (is.data.frame(newdata))
#> as.matrix(model.frame(delete.response(terms(object)), : reciprocal
#> condition number 2.3619e-17
#> Warning in predLoess(object$y, object$x, newx = if
#> (is.null(newdata)) object$x else if (is.data.frame(newdata))
#> as.matrix(model.frame(delete.response(terms(object)), : There are other
#> near singularities as well. 49.702

Port Hedland

tracks_pth <- tracks %>% filter_2017 %>% filter_port_hedland
tracks_pth %>% tracks_map
tracks_pth %>% DT::datatable(.)
tracks_pth %>% daily_summary
tracks_pth %>% tracks_ts
#> `geom_smooth()` using method = 'loess'


# named_nests_pth <- tracks_pth %>% filter(!(is.na(name)))
# named_nests_pth %>% tracks_map
# named_nests_pth %>% DT::datatable(.)

West Pilbara Turtle Program

tracks_wp <- tracks %>% filter_2017 %>% filter_west_pilbara
tracks_wp %>% tracks_map
tracks_wp %>% DT::datatable(.)
tracks_wp %>% daily_summary
tracks_wp %>% tracks_ts
#> `geom_smooth()` using method = 'loess'
#> Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
#> parametric, : span too small. fewer data values than degrees of freedom.
#> Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
#> parametric, : pseudoinverse used at 17494
#> Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
#> parametric, : neighborhood radius 14.275
#> Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
#> parametric, : reciprocal condition number 0
#> Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
#> parametric, : There are other near singularities as well. 1703.6
#> Warning in predLoess(object$y, object$x, newx = if
#> (is.null(newdata)) object$x else if (is.data.frame(newdata))
#> as.matrix(model.frame(delete.response(terms(object)), : span too small.
#> fewer data values than degrees of freedom.
#> Warning in predLoess(object$y, object$x, newx = if
#> (is.null(newdata)) object$x else if (is.data.frame(newdata))
#> as.matrix(model.frame(delete.response(terms(object)), : pseudoinverse used
#> at 17494
#> Warning in predLoess(object$y, object$x, newx = if
#> (is.null(newdata)) object$x else if (is.data.frame(newdata))
#> as.matrix(model.frame(delete.response(terms(object)), : neighborhood radius
#> 14.275
#> Warning in predLoess(object$y, object$x, newx = if
#> (is.null(newdata)) object$x else if (is.data.frame(newdata))
#> as.matrix(model.frame(delete.response(terms(object)), : reciprocal
#> condition number 0
#> Warning in predLoess(object$y, object$x, newx = if
#> (is.null(newdata)) object$x else if (is.data.frame(newdata))
#> as.matrix(model.frame(delete.response(terms(object)), : There are other
#> near singularities as well. 1703.6

Delambre Island

tracks_de <- tracks %>% filter_2017 %>% filter_delambre
tracks_de %>% tracks_map
tracks_de %>% DT::datatable(.)
tracks_de %>% daily_summary
tracks_de %>% tracks_ts
#> `geom_smooth()` using method = 'loess'
#> Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
#> parametric, : span too small. fewer data values than degrees of freedom.
#> Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
#> parametric, : pseudoinverse used at 17508
#> Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
#> parametric, : neighborhood radius 3.27
#> Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
#> parametric, : reciprocal condition number 0
#> Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
#> parametric, : There are other near singularities as well. 2628.6
#> Warning in predLoess(object$y, object$x, newx = if
#> (is.null(newdata)) object$x else if (is.data.frame(newdata))
#> as.matrix(model.frame(delete.response(terms(object)), : span too small.
#> fewer data values than degrees of freedom.
#> Warning in predLoess(object$y, object$x, newx = if
#> (is.null(newdata)) object$x else if (is.data.frame(newdata))
#> as.matrix(model.frame(delete.response(terms(object)), : pseudoinverse used
#> at 17508
#> Warning in predLoess(object$y, object$x, newx = if
#> (is.null(newdata)) object$x else if (is.data.frame(newdata))
#> as.matrix(model.frame(delete.response(terms(object)), : neighborhood radius
#> 3.27
#> Warning in predLoess(object$y, object$x, newx = if
#> (is.null(newdata)) object$x else if (is.data.frame(newdata))
#> as.matrix(model.frame(delete.response(terms(object)), : reciprocal
#> condition number 0
#> Warning in predLoess(object$y, object$x, newx = if
#> (is.null(newdata)) object$x else if (is.data.frame(newdata))
#> as.matrix(model.frame(delete.response(terms(object)), : There are other
#> near singularities as well. 2628.6
#> Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
#> parametric, : pseudoinverse used at 17510
#> Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
#> parametric, : neighborhood radius 2
#> Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
#> parametric, : reciprocal condition number 5.1026e-17
#> Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
#> parametric, : There are other near singularities as well. 4
#> Warning in predLoess(object$y, object$x, newx = if
#> (is.null(newdata)) object$x else if (is.data.frame(newdata))
#> as.matrix(model.frame(delete.response(terms(object)), : pseudoinverse used
#> at 17510
#> Warning in predLoess(object$y, object$x, newx = if
#> (is.null(newdata)) object$x else if (is.data.frame(newdata))
#> as.matrix(model.frame(delete.response(terms(object)), : neighborhood radius
#> 2
#> Warning in predLoess(object$y, object$x, newx = if
#> (is.null(newdata)) object$x else if (is.data.frame(newdata))
#> as.matrix(model.frame(delete.response(terms(object)), : reciprocal
#> condition number 5.1026e-17
#> Warning in predLoess(object$y, object$x, newx = if
#> (is.null(newdata)) object$x else if (is.data.frame(newdata))
#> as.matrix(model.frame(delete.response(terms(object)), : There are other
#> near singularities as well. 4

Rosemary Island

Data pending upload from tablets.

tracks_ri <- tracks %>% filter_2017 %>% filter_rosemary
tracks_ri %>% tracks_map
tracks_ri %>% DT::datatable(.)
tracks_ri %>% daily_summary
tracks_ri %>% tracks_ts

Thevenard Island

tracks_thv <- tracks %>% filter_2017 %>% filter_thevenard
tracks_thv %>% tracks_map
tracks_thv %>% DT::datatable(.)
#> Warning in instance$preRenderHook(instance): It seems your data is too
#> big for client-side DataTables. You may consider server-side processing:
#> http://rstudio.github.io/DT/server.html
tracks_thv %>% daily_summary
tracks_thv %>% tracks_ts
#> `geom_smooth()` using method = 'loess'
#> Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
#> parametric, : span too small. fewer data values than degrees of freedom.
#> Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
#> parametric, : at 17506
#> Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
#> parametric, : radius 2.5e-05
#> Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
#> parametric, : all data on boundary of neighborhood. make span bigger
#> Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
#> parametric, : pseudoinverse used at 17506
#> Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
#> parametric, : neighborhood radius 0.005
#> Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
#> parametric, : reciprocal condition number 1
#> Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
#> parametric, : at 17507
#> Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
#> parametric, : radius 2.5e-05
#> Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
#> parametric, : all data on boundary of neighborhood. make span bigger
#> Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
#> parametric, : There are other near singularities as well. 2.5e-05
#> Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
#> parametric, : zero-width neighborhood. make span bigger

#> Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
#> parametric, : zero-width neighborhood. make span bigger
#> Warning: Computation failed in `stat_smooth()`:
#> NA/NaN/Inf in foreign function call (arg 5)